package Stdlog;

require 5.008;
use strict;
use warnings;

use Exporter;
use Tie::Scalar;
use Stdlog::Levels;
use Stdlog::Config;
use Stdlog::Formatter;
use Stdlog::Writer;
use Stdlog::Criteria;
use Stdlog::Logger;
use Stdlog::Globals;

# Exports
our @ISA = qw/Exporter/;
our %EXPORT_TAGS = (
    'all'       => [qw(fatal error notice info debug $verbose $debug)],
    'functions' => [qw(fatal error notice info debug)],
    'vars'      => [qw($verbose $debug)],
);
our @EXPORT_OK = (@{$EXPORT_TAGS{'all'}});
our @EXPORT = (@{$EXPORT_TAGS{'functions'}});

our $VERSION = '0.10';

# Globals used to change the severity criteria of the "default" logger
our $verbose = 0;
our $debug   = 0;

tie $verbose, 'Stdlog::Globals::Verbose';
tie $debug, 'Stdlog::Globals::Debug';


my $default_logger_opts = {
    severity => 'NOTICE+',
    writer => 'STDERR'
};

our $default_logger = Stdlog::Logger->new($default_logger_opts);
our @loggers = ( $default_logger );


sub config {
    shift @_;
    Stdlog::Config->config(@_);
}


sub fatal {
    my @info = caller(1);
    my $args = {
        severity => 'FATAL',
        package  => $info[0],
        filename => $info[1],
        line     => $info[2],
        subname  => $info[3],
        time     => time(),
        opts     => ref $_[0] ? shift @_ : {},
    };
    for (@loggers){
        if( $_->{criteria}->( $args ) ){
            $_->{writer}->logmsg( $args, $_->{format}->($args, @_) );
        }
        last unless $_->{continue};
    }
    exit exists $args->{opts}{exit} ? $args->{opts}{exit} : -1;
}

sub error {
    my @info = caller(1);
    my $args = {
        severity => 'ERROR',
        package  => $info[0],
        filename => $info[1],
        line     => $info[2],
        subname  => $info[3],
        time     => time(),
        opts     => ref $_[0] ? shift @_ : {},
    };
    for (@loggers){
        if( $_->{criteria}->( $args ) ){
            $_->{writer}->logmsg( $args, $_->{format}->($args, @_) );
        }
        last unless $_->{continue};
    }
}

sub notice {
    my @info = caller(1);
    my $args = {
        severity => 'NOTICE',
        package  => $info[0],
        filename => $info[1],
        line     => $info[2],
        subname  => $info[3],
        time     => time(),
        opts     => ref $_[0] ? shift @_ : {},
    };
    for (@loggers){
        if( $_->{criteria}->( $args ) ){
            $_->{writer}->logmsg( $args, $_->{format}->($args, @_) );
        }
        last unless $_->{continue};
    }
}

sub info {
    my @info = caller(1);
    my $args = {
        severity => 'INFO',
        package  => $info[0],
        filename => $info[1],
        line     => $info[2],
        subname  => $info[3],
        time     => time(),
        opts     => ref $_[0] ? shift @_ : {},
    };
    for (@loggers){
        if( $_->{criteria}->( $args ) ){
            $_->{writer}->logmsg( $args, $_->{format}->($args, @_) );
        }
        last unless $_->{continue};
    }
}

sub debug {
    my @info = caller(1);
    my $args = {
        severity => 'DEBUG',
        package  => $info[0],
        filename => $info[1],
        line     => $info[2],
        subname  => $info[3],
        time     => time(),
        opts     => ref $_[0] ? shift @_ : {},
    };
    for (@loggers){
        if( $_->{criteria}->( $args ) ){
            $_->{writer}->logmsg( $args, $_->{format}->($args, @_) );
        }
        last unless $_->{continue};
    }
}

sub install_warn {
    $SIG{__WARN__} = sub {
        die @_ unless defined($^S) && $^S == 0;

        my @info = caller(1);
        my $args = {
            severity => 'FATAL',
            package  => $info[0],
            filename => $info[1],
            line     => $info[2],
            subname  => $info[3],
            time     => time(),
            opts     => ref $_[0] ? shift @_ : {},
        };
        for (@loggers){
            if( $_->{criteria}->( $args ) ){
                $_->{writer}->logmsg( $args, $_->{format}->($args, @_) );
            }
            last unless $_->{continue};
        }
    };
}

sub install_die {
    $SIG{__DIE__} = sub {
        die @_ unless defined($^S) && $^S == 0;
        
        my @info = caller(1);
        my $args = {
            severity => 'FATAL',
            package  => $info[0],
            filename => $info[1],
            line     => $info[2],
            subname  => $info[3],
            time     => time(),
            opts     => ref $_[0] ? shift @_ : {},
        };
        for (@loggers){
            if( $_->{criteria}->( $args ) ){
                $_->{writer}->logmsg( $args, $_->{format}->($args, @_) );
            }
            last unless $_->{continue};
        }
        exit(-1);
    };
}


sub loggers {
    return wantarray ? @loggers : \@loggers;
}


sub default_logger {
    return $default_logger;
}

# Returns the logger named $name
sub get {
    my ($pkg, $name) = @_;
    for (@loggers){
        return $_ if $_->{name} eq $name;
    }
    return undef;
}


1;
__END__

=head1 NAME

Stdlog - a simple but flexible logging package

=head1 SYNOPSIS

  use Stdlog;
  
  # Call this before calling logging functions
  Stdlog->config('General', $conf);
  
  warn("This is a warning");
  error("This is an error -- equivalent to warn");
  fatal("This is a fatal error -- equivalent to die");


=head1 DESCRIPTION

Stdlog is a logging subsystem designed for flexibility, ease of use and speed.
At its simplest, it is auto-configuring and will emit messages to 

=head1 EXPORTED FUNCTIONS

=head2 Stdlog->config($conf)

Class method to configure Stdlog.  Accepts an arrayref to an array of logger
configurations or a hashref to a set of logger configurations as the sole
argument and true if configured successfully.  May throw an exception via
die().

See Stdlog::Config for more details on configuration.

=head2 fatal([$args], @msgs)

=head2 error([$args], @msgs)

=head2 notice([$args], @msgs)

=head2 info([$args], @msgs)

=head2 debug([$args], @msgs)

=head2 Stdlog->loggers()

Returns the list of loggers (or an arrayref in scalar context).  Each element
of the list is a Stdlog::Logger object.

=head2 Stdlog->add($logger)

=head2 Stdlog->remove($logger|$index)

=head2 Stdlog->priority($logger, $index)

=head2 Stdlog->clear()

=head2 Stdlog->reset()


=head1 CONFIGURATION

=head2 $verbose and $debug

The $verbose global can be imported and, if set to a true value, changes the
criteria of the default logger to log messages with a severity of INFO or
greater.  IOW, it will log everything but DEBUG messages.

Similarlly, if the $debug global is set to a true value, the default logger
will log messages with a severity of DEBUG or greater.  IOW, it will log every
message.

=head2 Criteria Parameters

=over 8

=item facility

=item package

You can specify one or more packages in a comma seperated list.  They must be
either complete package names (e.g. Foo::Bar) or, if delimited by slashes (/),
a regular expression (e.g. /Foo::.*::Bar/).

=item severity

Specify the severity levels in a comma seperated list.  They can further be
qualified using + or - after the severity level, indicating "or higher" and
"or lower" respecively.

=item variable

You can specify variables to check.  The only local variable available is the
$args argument.  However, you can access the $opts hashref you may have
passed as the first argument to the top-level logging functions via $args->{opts}.

The format is a comma seperatd list of name => value pairs.  Where name is the
name of the variable and value is the value to check against.  Value can be a
constant scalar or a regular expression.

Examples:

  $foo => "bar"
  $alpha => /^\d+$/, $bravo => BRAVO

=item var

Shorthand for the 'variable' parameter.  In all ways the same as 'variable'.

=item expression

Provide an arbitrary expression to evaluate.  It can reference global variables,
the $args hashref argument, and even call functions.  The expression is
surrounded by parenthesis before being used.

N.B. Use of this feature is quite dangerous.  Make sure your system is secure
before turning it on via the 'expression-criterias' option.

=item expr

Shorthand for the 'expression' parameter.  In all ways the same as 'expression'.

=back

N.B. Criteria are logical OR'd together using || in the order they are
encountered in the configuration.  This is to allow you to optimize speed
since ||'s short circuit on the first true component.

=head2 Format String Parameters

=over 8

=item facility

=item severity

=item message

=item package

=item datetime

=item date

=item time

=item timestamp

=item gmdate

=item gmtime

=item env

=item opt

=item host

=item pid

=item tid

=item filename

=item line

=item exception

=item errno

=item osname

=item var

=item expr

=item uid

=item euid

=item gid

=item egid

=item 



=back

=head1 PERFORMANCE

It is critical that logging is as fast as possible so that it does not impact
the performance of the hosting application.  Stdlog is probably "fast enough".
On a 2.4GHz Core2Duo it takes less than 10 microseconds to decide not to log
a message using a simple severity based criteria.  Excluding the actual I/O, it
takes less than 20 microseconds to actually log a simple message.

Thus, if you have 100 logging statements executing per second, only 1.0 msec of
time will be spent deciding to log, about 0.1% of the total execution time.

Anyone who peeks at the code will note that there is some repetition.  While
this may not generally be good form, it helps to increase performance.

=head1 AUTHOR

Robert Mah E<lt>rmah@pobox.comE<gt>


=head1 COPYRIGHT AND LICENSE

Copyright (C) 2007 by Robert Mah

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.

=cut
